home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / setdefs.c < prev    next >
Text File  |  1994-01-03  |  29KB  |  1,311 lines
  1. # include "SetDefs.h"
  2. # include "yySDefs.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 31 "SetDefs.puma"
  36.  
  37.  
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40. # include "protocol.h"
  41.  
  42. # include "Types.h"
  43. # include "Transfor.h"    /* MakeFuncCall */
  44.  
  45.  
  46.  
  47. static FILE * yyf = stdout;
  48.  
  49. static void yyAbort
  50. # ifdef __cplusplus
  51.  (char * yyFunction)
  52. # else
  53.  (yyFunction) char * yyFunction;
  54. # endif
  55. {
  56.  (void) fprintf (stderr, "Error: module SetDefs, routine %s failed\n", yyFunction);
  57.  exit (1);
  58. }
  59.  
  60. void MakeACFDefs ARGS((tTree t));
  61. static void MakeStmtDefs ARGS((tTree t));
  62. static void MakeFuncCallDefs ARGS((tTree t));
  63. static void MakeParamDefs ARGS((tTree t));
  64. void MakeIndexDefs ARGS((tTree t));
  65. void MakeVarDefs ARGS((tTree t));
  66. static void MakeSubstring ARGS((tTree t));
  67. tTree CheckExp ARGS((tTree t));
  68. static tTree ObjTypePtr ARGS((tDefinitions v));
  69. static tTree TreeTypePtr ARGS((tTree t));
  70. static tTree VarSelect ARGS((tTree var, tTree stype));
  71. static tTree MakeTypeExp ARGS((tIdent id, tTree exps));
  72.  
  73. void MakeACFDefs
  74. # if defined __STDC__ | defined __cplusplus
  75. (register tTree t)
  76. # else
  77. (t)
  78.  register tTree t;
  79. # endif
  80. {
  81.   if (t == NoTree) return;
  82.  
  83.   switch (t->Kind) {
  84.   case kACF_LIST:
  85. # line 50 "SetDefs.puma"
  86.   {
  87. # line 51 "SetDefs.puma"
  88.    set_protocol_stmt (t->ACF_LIST.Elem);
  89. # line 52 "SetDefs.puma"
  90.    MakeACFDefs (t->ACF_LIST.Elem);
  91. # line 53 "SetDefs.puma"
  92.    MakeACFDefs (t->ACF_LIST.Next);
  93.   }
  94.    return;
  95.  
  96.   case kACF_DUMMY:
  97. # line 56 "SetDefs.puma"
  98.    return;
  99.  
  100.   case kACF_EMPTY:
  101. # line 59 "SetDefs.puma"
  102.    return;
  103.  
  104.   case kACF_BASIC:
  105. # line 62 "SetDefs.puma"
  106.   {
  107. # line 63 "SetDefs.puma"
  108.    MakeStmtDefs (t->ACF_BASIC.BASIC_STMT);
  109.   }
  110.    return;
  111.  
  112.   case kACF_IF:
  113. # line 66 "SetDefs.puma"
  114.   {
  115. # line 68 "SetDefs.puma"
  116.  t->ACF_IF.IF_EXP = CheckExp (t->ACF_IF.IF_EXP);
  117. # line 69 "SetDefs.puma"
  118.    MakeACFDefs (t->ACF_IF.THEN_PART);
  119. # line 70 "SetDefs.puma"
  120.    MakeACFDefs (t->ACF_IF.ELSE_PART);
  121.   }
  122.    return;
  123.  
  124.   case kACF_WHERE:
  125. # line 73 "SetDefs.puma"
  126.   {
  127. # line 74 "SetDefs.puma"
  128.  t->ACF_WHERE.WHERE_EXP = CheckExp (t->ACF_WHERE.WHERE_EXP);
  129. # line 75 "SetDefs.puma"
  130.    MakeACFDefs (t->ACF_WHERE.TRUE_PART);
  131. # line 76 "SetDefs.puma"
  132.    MakeACFDefs (t->ACF_WHERE.FALSE_PART);
  133.   }
  134.    return;
  135.  
  136.   case kACF_CASE:
  137. # line 79 "SetDefs.puma"
  138.   {
  139. # line 80 "SetDefs.puma"
  140.  t->ACF_CASE.CASE_EXP = CheckExp (t->ACF_CASE.CASE_EXP);
  141. # line 81 "SetDefs.puma"
  142.    MakeACFDefs (t->ACF_CASE.CASE_ALTS);
  143. # line 82 "SetDefs.puma"
  144.    MakeACFDefs (t->ACF_CASE.CASE_OTHERWISE);
  145.   }
  146.    return;
  147.  
  148.   case kSELECTED_ACF_LIST:
  149. # line 85 "SetDefs.puma"
  150.   {
  151. # line 86 "SetDefs.puma"
  152.    MakeACFDefs (t->SELECTED_ACF_LIST.Elem);
  153. # line 87 "SetDefs.puma"
  154.    MakeACFDefs (t->SELECTED_ACF_LIST.Next);
  155.   }
  156.    return;
  157.  
  158.   case kSELECTED_ACF_EMPTY:
  159. # line 90 "SetDefs.puma"
  160.    return;
  161.  
  162.   case kSELECTED_ACF_NODE:
  163. # line 93 "SetDefs.puma"
  164.   {
  165. # line 94 "SetDefs.puma"
  166.    MakeIndexDefs (t->SELECTED_ACF_NODE.SELECT_LIST);
  167. # line 95 "SetDefs.puma"
  168.    MakeACFDefs (t->SELECTED_ACF_NODE.SELECT_ACFS);
  169.   }
  170.    return;
  171.  
  172.   case kACF_WHILE:
  173. # line 98 "SetDefs.puma"
  174.   {
  175. # line 99 "SetDefs.puma"
  176.  t->ACF_WHILE.WHILE_EXP = CheckExp (t->ACF_WHILE.WHILE_EXP);
  177. # line 101 "SetDefs.puma"
  178.    MakeACFDefs (t->ACF_WHILE.WHILE_BODY);
  179.   }
  180.    return;
  181.  
  182.   case kACF_LOOP:
  183. # line 104 "SetDefs.puma"
  184.   {
  185. # line 105 "SetDefs.puma"
  186.    MakeACFDefs (t->ACF_LOOP.LOOP_BODY);
  187.   }
  188.    return;
  189.  
  190.   case kACF_DO:
  191. # line 108 "SetDefs.puma"
  192.   {
  193. # line 109 "SetDefs.puma"
  194.    MakeVarDefs (t->ACF_DO.DO_ID);
  195. # line 110 "SetDefs.puma"
  196.  t->ACF_DO.DO_RANGE = CheckExp (t->ACF_DO.DO_RANGE);
  197. # line 111 "SetDefs.puma"
  198.    MakeACFDefs (t->ACF_DO.DO_BODY);
  199.   }
  200.    return;
  201.  
  202.   case kACF_DOLOCAL:
  203. # line 114 "SetDefs.puma"
  204.   {
  205. # line 115 "SetDefs.puma"
  206.    MakeVarDefs (t->ACF_DOLOCAL.DOLOCAL_ID);
  207. # line 116 "SetDefs.puma"
  208.  t->ACF_DOLOCAL.DOLOCAL_RANGE = CheckExp (t->ACF_DOLOCAL.DOLOCAL_RANGE);
  209. # line 117 "SetDefs.puma"
  210.    MakeACFDefs (t->ACF_DOLOCAL.DOLOCAL_BODY);
  211.   }
  212.    return;
  213.  
  214.   case kACF_FORALL:
  215. # line 120 "SetDefs.puma"
  216.   {
  217. # line 121 "SetDefs.puma"
  218.    MakeVarDefs (t->ACF_FORALL.FORALL_ID);
  219. # line 122 "SetDefs.puma"
  220.  t->ACF_FORALL.FORALL_RANGE = CheckExp (t->ACF_FORALL.FORALL_RANGE);
  221. # line 123 "SetDefs.puma"
  222.    MakeACFDefs (t->ACF_FORALL.FORALL_BODY);
  223.   }
  224.    return;
  225.  
  226.   case kACF_DOALL:
  227. # line 126 "SetDefs.puma"
  228.   {
  229. # line 127 "SetDefs.puma"
  230.    MakeVarDefs (t->ACF_DOALL.DOALL_NEW);
  231. # line 128 "SetDefs.puma"
  232.    MakeVarDefs (t->ACF_DOALL.DOALL_ID);
  233. # line 129 "SetDefs.puma"
  234.  t->ACF_DOALL.DOALL_RANGE = CheckExp (t->ACF_DOALL.DOALL_RANGE);
  235. # line 130 "SetDefs.puma"
  236.    MakeACFDefs (t->ACF_DOALL.DOALL_BODY);
  237.   }
  238.    return;
  239.  
  240.   case kACF_ENTRY:
  241. # line 133 "SetDefs.puma"
  242.   {
  243. # line 134 "SetDefs.puma"
  244.    tree_error_protocol ("entry statement not supported", t);
  245.   }
  246.    return;
  247.  
  248.   }
  249.  
  250. # line 137 "SetDefs.puma"
  251.   {
  252. # line 138 "SetDefs.puma"
  253.    printf ("MakeACFDefs failed\n");
  254. # line 139 "SetDefs.puma"
  255.    FileUnparse (stdout, t);
  256. # line 140 "SetDefs.puma"
  257.    WriteTree (stdout, t);
  258. # line 141 "SetDefs.puma"
  259.    kill_in_protocol ();
  260.   }
  261.    return;
  262.  
  263. ;
  264. }
  265.  
  266. static void MakeStmtDefs
  267. # if defined __STDC__ | defined __cplusplus
  268. (register tTree t)
  269. # else
  270. (t)
  271.  register tTree t;
  272. # endif
  273. {
  274. # line 152 "SetDefs.puma"
  275.  
  276. char string[100];
  277.  
  278.   if (t == NoTree) return;
  279.  
  280.   switch (t->Kind) {
  281.   case kASSIGN_STMT:
  282. # line 156 "SetDefs.puma"
  283.   {
  284. # line 157 "SetDefs.puma"
  285.    MakeVarDefs (t->ASSIGN_STMT.ASSIGN_VAR);
  286. # line 158 "SetDefs.puma"
  287.    if (! (t->ASSIGN_STMT.ASSIGN_EXP = CheckExp (t->ASSIGN_STMT.ASSIGN_EXP))) goto yyL1;
  288.   }
  289.    return;
  290. yyL1:;
  291.  
  292.   break;
  293.   case kCALL_STMT:
  294. # line 161 "SetDefs.puma"
  295.  {
  296.   tDefinitions Obj;
  297.   tTree Decl;
  298.   {
  299. # line 163 "SetDefs.puma"
  300.  
  301. # line 164 "SetDefs.puma"
  302.  
  303. # line 166 "SetDefs.puma"
  304.  Obj = GetLocalDecl (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident);
  305.      if (Obj == NoObject)
  306.        { Obj = GetOtherDecl (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident);
  307.          if (Obj != NoObject)
  308.             InsertEntry (Obj);
  309.        }
  310.      GetString (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, string);
  311.      if (Obj == NoObject)
  312.        { printf ("**** subroutine %s not declared (external)\n",string);
  313.          Decl = mEXT_PROC_DECL (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, 0, mDECL_EMPTY());
  314.          Obj = mProcObject (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, Decl, 1, mENTRY_EMPTY());
  315.          InsertExternalEntry (Obj);
  316.        }
  317.      else if (Obj->Kind != kProcObject)
  318.        error_protocol ("Not a subroutine");
  319.  
  320. # line 182 "SetDefs.puma"
  321.    t->CALL_STMT.CALL_ID->PROC_OBJ.Object = Obj;
  322. # line 183 "SetDefs.puma"
  323.    MakeParamDefs (t->CALL_STMT.CALL_PARAMS);
  324.   }
  325.    return;
  326.  }
  327.  
  328.   case kIO_STMT:
  329. # line 186 "SetDefs.puma"
  330.   {
  331. # line 187 "SetDefs.puma"
  332.    MakeParamDefs (t->IO_STMT.IO_SPECS);
  333. # line 188 "SetDefs.puma"
  334.    MakeParamDefs (t->IO_STMT.IO_ITEMS);
  335.   }
  336.    return;
  337.  
  338.   case kGOTO_STMT:
  339. # line 191 "SetDefs.puma"
  340.    return;
  341.  
  342.   case kLABEL_ASSIGN_STMT:
  343. # line 194 "SetDefs.puma"
  344.   {
  345. # line 195 "SetDefs.puma"
  346.    MakeVarDefs (t->LABEL_ASSIGN_STMT.LABEL_VAR);
  347.   }
  348.    return;
  349.  
  350.   case kPTR_ASSIGN_STMT:
  351. # line 198 "SetDefs.puma"
  352.   {
  353. # line 199 "SetDefs.puma"
  354.    error_protocol ("pointer assignment not supported");
  355.   }
  356.    return;
  357.  
  358.   case kASS_GOTO_STMT:
  359. # line 202 "SetDefs.puma"
  360.   {
  361. # line 203 "SetDefs.puma"
  362.    MakeVarDefs (t->ASS_GOTO_STMT.GOTO_VAR);
  363.   }
  364.    return;
  365.  
  366.   case kCOMP_GOTO_STMT:
  367. # line 206 "SetDefs.puma"
  368.   {
  369. # line 207 "SetDefs.puma"
  370.  t->COMP_GOTO_STMT.GOTO_EXP = CheckExp (t->COMP_GOTO_STMT.GOTO_EXP);
  371.   }
  372.    return;
  373.  
  374.   case kCOMP_IF_STMT:
  375. # line 210 "SetDefs.puma"
  376.   {
  377. # line 211 "SetDefs.puma"
  378.  t->COMP_IF_STMT.IF_EXP = CheckExp (t->COMP_IF_STMT.IF_EXP);
  379.   }
  380.    return;
  381.  
  382.   case kRETURN_STMT:
  383. # line 214 "SetDefs.puma"
  384.   {
  385. # line 215 "SetDefs.puma"
  386.  t->RETURN_STMT.RETURN_EXP = CheckExp (t->RETURN_STMT.RETURN_EXP);
  387.   }
  388.    return;
  389.  
  390.   case kFORMAT_STMT:
  391. # line 218 "SetDefs.puma"
  392.    return;
  393.  
  394.   case kSTOP_STMT:
  395. # line 221 "SetDefs.puma"
  396.   {
  397. # line 222 "SetDefs.puma"
  398.  t->STOP_STMT.STOP_CONST = CheckExp (t->STOP_STMT.STOP_CONST);
  399.   }
  400.    return;
  401.  
  402.   case kEXIT_STMT:
  403. # line 225 "SetDefs.puma"
  404.    return;
  405.  
  406.   case kCYCLE_STMT:
  407. # line 228 "SetDefs.puma"
  408.    return;
  409.  
  410.   case kALLOCATE_STMT:
  411. # line 231 "SetDefs.puma"
  412.   {
  413. # line 232 "SetDefs.puma"
  414.    MakeParamDefs (t->ALLOCATE_STMT.PARAMS);
  415. # line 233 "SetDefs.puma"
  416.    MakeVarDefs (t->ALLOCATE_STMT.STAT);
  417.   }
  418.    return;
  419.  
  420.   case kDEALLOCATE_STMT:
  421. # line 236 "SetDefs.puma"
  422.   {
  423. # line 237 "SetDefs.puma"
  424.    MakeParamDefs (t->DEALLOCATE_STMT.PARAMS);
  425. # line 238 "SetDefs.puma"
  426.    MakeVarDefs (t->DEALLOCATE_STMT.STAT);
  427.   }
  428.    return;
  429.  
  430.   case kREDUCE_STMT:
  431. # line 241 "SetDefs.puma"
  432.   {
  433. # line 242 "SetDefs.puma"
  434.  t->REDUCE_STMT.RED_FUNC->PROC_OBJ.Object = GetDeclEntry (t->REDUCE_STMT.RED_FUNC->PROC_OBJ.Ident, GetIntrinsicEntries ());
  435.      if (!IntrFuncRed (t->REDUCE_STMT.RED_FUNC->PROC_OBJ.Ident))
  436.         error_protocol ("reduce function no reduction");
  437.      if (t->REDUCE_STMT.RED_FUNC->PROC_OBJ.Object == NoObject)
  438.         error_protocol ("reduce function not intrinsic");
  439.  
  440. # line 248 "SetDefs.puma"
  441.    MakeParamDefs (t->REDUCE_STMT.RED_PARAMS);
  442.   }
  443.    return;
  444.  
  445.   case kALIGN_STMT:
  446. # line 251 "SetDefs.puma"
  447.   {
  448. # line 252 "SetDefs.puma"
  449.    error_protocol ("realign not supported");
  450.   }
  451.    return;
  452.  
  453.   case kDISTRIBUTE_STMT:
  454. # line 255 "SetDefs.puma"
  455.   {
  456. # line 256 "SetDefs.puma"
  457.    error_protocol ("distribute not supported");
  458.   }
  459.    return;
  460.  
  461.   case kNULLIFY_STMT:
  462. # line 259 "SetDefs.puma"
  463.   {
  464. # line 260 "SetDefs.puma"
  465.    error_protocol ("nullify not supported");
  466.   }
  467.    return;
  468.  
  469.   }
  470.  
  471. # line 263 "SetDefs.puma"
  472.   {
  473. # line 264 "SetDefs.puma"
  474.    printf ("MakeStmtDefs failed\n");
  475. # line 265 "SetDefs.puma"
  476.    FileUnparse (stdout, t);
  477. # line 266 "SetDefs.puma"
  478.    WriteTree (stdout, t);
  479. # line 267 "SetDefs.puma"
  480.    kill_in_protocol ();
  481.   }
  482.    return;
  483.  
  484. ;
  485. }
  486.  
  487. static void MakeFuncCallDefs
  488. # if defined __STDC__ | defined __cplusplus
  489. (register tTree t)
  490. # else
  491. (t)
  492.  register tTree t;
  493. # endif
  494. {
  495. # line 278 "SetDefs.puma"
  496.  
  497. tObject Obj;
  498. tTree   Decl;
  499. char string[100];
  500.  
  501.   if (t == NoTree) return;
  502.   if (t->Kind == kFUNC_CALL_EXP) {
  503. # line 284 "SetDefs.puma"
  504.   {
  505. # line 289 "SetDefs.puma"
  506.  Obj = GetLocalDecl (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident);
  507.      if (Obj != NoObject)
  508.        {
  509.          if (Obj->Kind != kFuncObject)
  510.            { MakeObjExternal (t, Obj);
  511.              Obj = GetLocalDecl (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident);
  512.            }
  513.        }
  514.       else
  515.        { Obj = GetLocalDecl (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident);
  516.          if (Obj == NoObject)
  517.             Obj = GetOtherDecl (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident);
  518.          if (Obj != NoObject)
  519.             InsertEntry (Obj);
  520.        }
  521.  
  522.      if (Obj == NoObject)
  523.        { tree_protocol ("new external function detected : ", t);
  524.          Decl = mEXT_FUNC_DECL (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident, 0, mDECL_EMPTY(), mDUMMY_TYPE());
  525.          Obj = mFuncObject (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident, Decl, 1, mENTRY_EMPTY ());
  526.          InsertExternalEntry (Obj);
  527.          InsertEntry (Obj);
  528.        }
  529.       else if (Obj->Kind != kFuncObject)
  530.          tree_error_protocol ("no function in function call ", t);
  531.      t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Object = Obj;
  532.  
  533.   }
  534.    return;
  535.  
  536.   }
  537. # line 318 "SetDefs.puma"
  538.   {
  539. # line 319 "SetDefs.puma"
  540.    printf ("MakeFuncCallDefs failed\n");
  541. # line 320 "SetDefs.puma"
  542.    FileUnparse (stdout, t);
  543. # line 321 "SetDefs.puma"
  544.    WriteTree (stdout, t);
  545. # line 322 "SetDefs.puma"
  546.    kill_in_protocol ();
  547.   }
  548.    return;
  549.  
  550. ;
  551. }
  552.  
  553. static void MakeParamDefs
  554. # if defined __STDC__ | defined __cplusplus
  555. (register tTree t)
  556. # else
  557. (t)
  558.  register tTree t;
  559. # endif
  560. {
  561. # line 342 "SetDefs.puma"
  562.  
  563. tObject Obj;
  564. tTree   Decl;
  565. char    string[100];
  566.  
  567.   if (t == NoTree) return;
  568.   if (t->Kind == kBTP_LIST) {
  569.   if (t->BTP_LIST.Elem->Kind == kVALUE_PARAM) {
  570.   if (t->BTP_LIST.Elem->VALUE_PARAM.E->Kind == kVAR_EXP) {
  571.   if (t->BTP_LIST.Elem->VALUE_PARAM.E->VAR_EXP.V->Kind == kUSED_VAR) {
  572. # line 354 "SetDefs.puma"
  573.  {
  574.   tDefinitions Obj;
  575.   tTree to;
  576.   {
  577. # line 357 "SetDefs.puma"
  578.  
  579. # line 358 "SetDefs.puma"
  580.  
  581. # line 360 "SetDefs.puma"
  582.    Obj = GetLocalDecl (t->BTP_LIST.Elem->VALUE_PARAM.E->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident);
  583. # line 362 "SetDefs.puma"
  584.    if (! (Obj != NoObject)) goto yyL1;
  585.   {
  586. # line 363 "SetDefs.puma"
  587.    if (! ((Obj -> Kind == kFuncObject) || (Obj -> Kind == kProcObject))) goto yyL1;
  588.   {
  589. # line 364 "SetDefs.puma"
  590.  to = mPROC_OBJ (t->BTP_LIST.Elem->VALUE_PARAM.E->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident);
  591.      to->PROC_OBJ.Object = Obj;
  592.      if (Obj->Kind == kFuncObject)
  593.        t->BTP_LIST.Elem = mFUNC_PARAM (to);
  594.       else
  595.        t->BTP_LIST.Elem = mPROC_PARAM (to);
  596.  
  597. # line 371 "SetDefs.puma"
  598.    MakeParamDefs (t->BTP_LIST.Next);
  599.   }
  600.   }
  601.   }
  602.    return;
  603.  }
  604. yyL1:;
  605.  
  606.   }
  607.   }
  608. # line 374 "SetDefs.puma"
  609.   {
  610. # line 375 "SetDefs.puma"
  611.  t->BTP_LIST.Elem->VALUE_PARAM.E = CheckExp (t->BTP_LIST.Elem->VALUE_PARAM.E);
  612.      if (t->BTP_LIST.Elem->VALUE_PARAM.E->Kind == kVAR_EXP)
  613.         t->BTP_LIST.Elem = mVAR_PARAM(t->BTP_LIST.Elem->VALUE_PARAM.E->VAR_EXP.V);
  614.       else
  615.         t->BTP_LIST.Elem = mVAR_PARAM (mADDR (t->BTP_LIST.Elem->VALUE_PARAM.E));
  616. # line 380 "SetDefs.puma"
  617.    MakeParamDefs (t->BTP_LIST.Next);
  618.   }
  619.    return;
  620.  
  621.   }
  622.   if (t->BTP_LIST.Elem->Kind == kNAMED_PARAM) {
  623.   if (t->BTP_LIST.Elem->NAMED_PARAM.VAL->Kind == kVALUE_PARAM) {
  624. # line 383 "SetDefs.puma"
  625.   {
  626. # line 384 "SetDefs.puma"
  627.  t->BTP_LIST.Elem->NAMED_PARAM.VAL->VALUE_PARAM.E = CheckExp (t->BTP_LIST.Elem->NAMED_PARAM.VAL->VALUE_PARAM.E);
  628.      if (t->BTP_LIST.Elem->NAMED_PARAM.VAL->VALUE_PARAM.E->Kind == kVAR_EXP)
  629.         t->BTP_LIST.Elem->NAMED_PARAM.VAL = mVAR_PARAM(t->BTP_LIST.Elem->NAMED_PARAM.VAL->VALUE_PARAM.E->VAR_EXP.V);
  630.       else
  631.         t->BTP_LIST.Elem->NAMED_PARAM.VAL = mVAR_PARAM (mADDR (t->BTP_LIST.Elem->NAMED_PARAM.VAL->VALUE_PARAM.E));
  632. # line 389 "SetDefs.puma"
  633.    MakeParamDefs (t->BTP_LIST.Next);
  634.   }
  635.    return;
  636.  
  637.   }
  638.   }
  639.   if (t->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  640. # line 392 "SetDefs.puma"
  641.   {
  642. # line 393 "SetDefs.puma"
  643.    MakeVarDefs (t->BTP_LIST.Elem->VAR_PARAM.V);
  644. # line 394 "SetDefs.puma"
  645.    MakeParamDefs (t->BTP_LIST.Next);
  646.   }
  647.    return;
  648.  
  649.   }
  650.   if (t->BTP_LIST.Elem->Kind == kFUNC_PARAM) {
  651. # line 397 "SetDefs.puma"
  652.   {
  653. # line 398 "SetDefs.puma"
  654.    error_protocol ("no function param from parsing");
  655.   }
  656.    return;
  657.  
  658.   }
  659.   if (t->BTP_LIST.Elem->Kind == kRETURN_PARAM) {
  660. # line 401 "SetDefs.puma"
  661.   {
  662. # line 402 "SetDefs.puma"
  663.    error_protocol ("actual return parameter not handled");
  664.   }
  665.    return;
  666.  
  667.   }
  668.   }
  669.   if (t->Kind == kBTP_EMPTY) {
  670. # line 405 "SetDefs.puma"
  671.    return;
  672.  
  673.   }
  674. # line 408 "SetDefs.puma"
  675.   {
  676. # line 409 "SetDefs.puma"
  677.    printf ("MakeParamDefs failed\n");
  678. # line 410 "SetDefs.puma"
  679.    FileUnparse (stdout, t);
  680. # line 411 "SetDefs.puma"
  681.    WriteTree (stdout, t);
  682. # line 412 "SetDefs.puma"
  683.    kill_in_protocol ();
  684.   }
  685.    return;
  686.  
  687. ;
  688. }
  689.  
  690. void MakeIndexDefs
  691. # if defined __STDC__ | defined __cplusplus
  692. (register tTree t)
  693. # else
  694. (t)
  695.  register tTree t;
  696. # endif
  697. {
  698.   if (t == NoTree) return;
  699.   if (t->Kind == kBTE_LIST) {
  700. # line 426 "SetDefs.puma"
  701.   {
  702. # line 427 "SetDefs.puma"
  703.    if (! (t->BTE_LIST.Elem = CheckExp (t->BTE_LIST.Elem))) goto yyL1;
  704.   {
  705. # line 428 "SetDefs.puma"
  706.    MakeIndexDefs (t->BTE_LIST.Next);
  707.   }
  708.   }
  709.    return;
  710. yyL1:;
  711.  
  712.   }
  713.   if (t->Kind == kBTE_EMPTY) {
  714. # line 431 "SetDefs.puma"
  715.    return;
  716.  
  717.   }
  718. # line 434 "SetDefs.puma"
  719.   {
  720. # line 435 "SetDefs.puma"
  721.    printf ("MakeIndexDefs failed\n");
  722. # line 436 "SetDefs.puma"
  723.    FileUnparse (stdout, t);
  724. # line 437 "SetDefs.puma"
  725.    WriteTree (stdout, t);
  726. # line 438 "SetDefs.puma"
  727.    kill_in_protocol ();
  728.   }
  729.    return;
  730.  
  731. ;
  732. }
  733.  
  734. void MakeVarDefs
  735. # if defined __STDC__ | defined __cplusplus
  736. (register tTree t)
  737. # else
  738. (t)
  739.  register tTree t;
  740. # endif
  741. {
  742.   if (t == NoTree) return;
  743.  
  744.   switch (t->Kind) {
  745.   case kBTV_LIST:
  746. # line 455 "SetDefs.puma"
  747.   {
  748. # line 456 "SetDefs.puma"
  749.    MakeVarDefs (t->BTV_LIST.Elem);
  750. # line 457 "SetDefs.puma"
  751.    MakeVarDefs (t->BTV_LIST.Next);
  752.   }
  753.    return;
  754.  
  755.   case kBTV_EMPTY:
  756. # line 460 "SetDefs.puma"
  757.    return;
  758.  
  759.   case kDUMMY_VAR:
  760. # line 463 "SetDefs.puma"
  761.    return;
  762.  
  763.   case kUSED_VAR:
  764. # line 466 "SetDefs.puma"
  765.   {
  766. # line 467 "SetDefs.puma"
  767.    MakeVarDefs (t->USED_VAR.VARNAME);
  768.   }
  769.    return;
  770.  
  771.   case kLOOP_VAR:
  772. # line 470 "SetDefs.puma"
  773.   {
  774. # line 471 "SetDefs.puma"
  775.    MakeVarDefs (t->LOOP_VAR.LOOP_VARNAME);
  776.   }
  777.    return;
  778.  
  779.   case kDO_VAR:
  780. # line 474 "SetDefs.puma"
  781.   {
  782. # line 475 "SetDefs.puma"
  783.    MakeVarDefs (t->DO_VAR.DO_ID);
  784. # line 476 "SetDefs.puma"
  785.  t->DO_VAR.RANGE = CheckExp (t->DO_VAR.RANGE);
  786. # line 477 "SetDefs.puma"
  787.    MakeVarDefs (t->DO_VAR.BODY);
  788.   }
  789.    return;
  790.  
  791.   case kVAR_OBJ:
  792. # line 486 "SetDefs.puma"
  793.  {
  794.   tDefinitions Obj;
  795.   tTree type;
  796.   {
  797. # line 488 "SetDefs.puma"
  798.  
  799. # line 489 "SetDefs.puma"
  800.  
  801. # line 491 "SetDefs.puma"
  802.    Obj = GetLocalDecl (t->VAR_OBJ.Ident);
  803. # line 493 "SetDefs.puma"
  804.  if (Obj == NoObject)
  805.       {
  806.         type = mDUMMY_TYPE ();
  807.         Obj  = mVarObject (t->VAR_OBJ.Ident, mVAR_DECL (t->VAR_OBJ.Ident, t->VAR_OBJ.Pos, type),
  808.                   mVarLocal (0,0), 0,
  809.                   mDefaultDistribution (0,0)   ) ;
  810.         InsertEntry (Obj);
  811.       }
  812.      else if (Obj->Kind == kProcObject)
  813.       { error_protocol ("variable and not subroutine expected");
  814.         tree_protocol ("the element is : ", t);
  815.       }
  816.      else if (Obj->Kind == kFuncObject)
  817.         {
  818.         }
  819.      else if (Obj->Kind == kVarObject)
  820.         {
  821.         }
  822.  
  823. # line 512 "SetDefs.puma"
  824.    t->VAR_OBJ.Object = Obj;
  825.   }
  826.    return;
  827.  }
  828.  
  829.   case kINDEXED_VAR:
  830. # line 521 "SetDefs.puma"
  831.  {
  832.   tTree tp;
  833.   tDefinitions Obj;
  834.   {
  835. # line 523 "SetDefs.puma"
  836.    MakeVarDefs (t->INDEXED_VAR.IND_VAR);
  837. # line 524 "SetDefs.puma"
  838.    MakeIndexDefs (t->INDEXED_VAR.IND_EXPS);
  839. # line 528 "SetDefs.puma"
  840.  
  841. # line 529 "SetDefs.puma"
  842.  
  843. # line 531 "SetDefs.puma"
  844.  tp = TreeTypePtr (t->INDEXED_VAR.IND_VAR);
  845.      if (tp == NoTree)
  846.         tree_error_protocol ("type of indexed var unknown", t);
  847.       else if (tp->Kind == kSTRING_TYPE)
  848.         MakeSubstring (t);
  849.       else if (tp->Kind != kARRAY_TYPE)
  850.         tree_error_protocol ("indexed var not an array",t);
  851.  
  852.   }
  853.    return;
  854.  }
  855.  
  856.   case kSELECTED_VAR:
  857. # line 541 "SetDefs.puma"
  858.  {
  859.   tTree tp;
  860.   tDefinitions Obj;
  861.   {
  862. # line 543 "SetDefs.puma"
  863.    MakeVarDefs (t->SELECTED_VAR.SELEC_VAR);
  864. # line 547 "SetDefs.puma"
  865.  
  866. # line 548 "SetDefs.puma"
  867.  
  868. # line 550 "SetDefs.puma"
  869.  tp = TreeTypePtr (t->SELECTED_VAR.SELEC_VAR);
  870.      if (tp == NoTree)
  871.         tree_error_protocol ("type of var to be selected unknown", t);
  872.       else if (tp->Kind != kTYPE_ID)
  873.         tree_error_protocol ("type of var to be selected not derived type",t);
  874.       else
  875.         { Obj = tp->TYPE_ID.ID->TYPE_OBJ.Object;
  876.           t->SELECTED_VAR.SELECTOR->REC_COMP.Object = GetDeclEntry (t->SELECTED_VAR.SELECTOR->REC_COMP.Ident, Obj->TypeObject.Components);
  877.           if (t->SELECTED_VAR.SELECTOR->REC_COMP.Object == NoObject)
  878.            tree_error_protocol ("component does not exist in derived type", t);
  879.         }
  880.  
  881.   }
  882.    return;
  883.  }
  884.  
  885.   }
  886.  
  887. # line 564 "SetDefs.puma"
  888.   {
  889. # line 565 "SetDefs.puma"
  890.    printf ("Unknown Tree for MakeVarDefs\n");
  891. # line 566 "SetDefs.puma"
  892.    FileUnparse (stdout, t);
  893. # line 567 "SetDefs.puma"
  894.    WriteTree (stdout, t);
  895. # line 568 "SetDefs.puma"
  896.    kill_in_protocol ();
  897.   }
  898.    return;
  899.  
  900. ;
  901. }
  902.  
  903. static void MakeSubstring
  904. # if defined __STDC__ | defined __cplusplus
  905. (register tTree t)
  906. # else
  907. (t)
  908.  register tTree t;
  909. # endif
  910. {
  911.   if (t == NoTree) return;
  912.   if (t->Kind == kINDEXED_VAR) {
  913.   if (t->INDEXED_VAR.IND_EXPS->Kind == kBTE_LIST) {
  914.   if (t->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  915.   if (t->INDEXED_VAR.IND_EXPS->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  916. # line 574 "SetDefs.puma"
  917.   {
  918. # line 575 "SetDefs.puma"
  919.  t->INDEXED_VAR.IND_EXPS = t->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem;
  920.     t->Kind = kSUBSTRING_VAR;
  921.  
  922.   }
  923.    return;
  924.  
  925.   }
  926.   }
  927.   }
  928.   }
  929. # line 580 "SetDefs.puma"
  930.   {
  931. # line 581 "SetDefs.puma"
  932.    tree_error_protocol ("indexed access to string illegal", t);
  933.   }
  934.    return;
  935.  
  936. ;
  937. }
  938.  
  939. tTree CheckExp
  940. # if defined __STDC__ | defined __cplusplus
  941. (register tTree t)
  942. # else
  943. (t)
  944.  register tTree t;
  945. # endif
  946. {
  947. # line 592 "SetDefs.puma"
  948.  
  949. tObject Obj;
  950. int rank;
  951. unsigned char string[256];
  952.  
  953.   switch (t->Kind) {
  954.   case kDUMMY_EXP:
  955. # line 597 "SetDefs.puma"
  956.    return t;
  957.  
  958.   case kCONST_EXP:
  959. # line 601 "SetDefs.puma"
  960.    return t;
  961.  
  962.   case kARRAY_EXP:
  963. # line 605 "SetDefs.puma"
  964.   {
  965. # line 606 "SetDefs.puma"
  966.    MakeIndexDefs (t->ARRAY_EXP.ELEMENTS);
  967.   }
  968.    return t;
  969.  
  970.   case kSLICE_EXP:
  971. # line 610 "SetDefs.puma"
  972.   {
  973. # line 611 "SetDefs.puma"
  974.  t->SLICE_EXP.START = CheckExp (t->SLICE_EXP.START);
  975.      t->SLICE_EXP.STOP  = CheckExp (t->SLICE_EXP.STOP);
  976.      t->SLICE_EXP.INC   = CheckExp (t->SLICE_EXP.INC);
  977.  
  978.   }
  979.    return t;
  980.  
  981.   case kOP_EXP:
  982. # line 618 "SetDefs.puma"
  983.   {
  984. # line 619 "SetDefs.puma"
  985.  t->OP_EXP.OPND1 = CheckExp (t->OP_EXP.OPND1);
  986.      t->OP_EXP.OPND2 = CheckExp (t->OP_EXP.OPND2);
  987.  
  988.   }
  989.    return t;
  990.  
  991.   case kOP1_EXP:
  992. # line 625 "SetDefs.puma"
  993.   {
  994. # line 626 "SetDefs.puma"
  995.  t->OP1_EXP.OPND = CheckExp (t->OP1_EXP.OPND);
  996.   }
  997.    return t;
  998.  
  999.   case kNAMED_EXP:
  1000. # line 630 "SetDefs.puma"
  1001.   {
  1002. # line 631 "SetDefs.puma"
  1003.  t->NAMED_EXP.VAL = CheckExp (t->NAMED_EXP.VAL);
  1004.   }
  1005.    return t;
  1006.  
  1007.   case kVAR_EXP:
  1008.   if (t->VAR_EXP.V->Kind == kINDEXED_VAR) {
  1009.   if (t->VAR_EXP.V->INDEXED_VAR.IND_EXPS->Kind == kBTE_LIST) {
  1010.   if (t->VAR_EXP.V->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  1011.   if (t->VAR_EXP.V->INDEXED_VAR.IND_EXPS->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  1012. # line 636 "SetDefs.puma"
  1013.   {
  1014. # line 640 "SetDefs.puma"
  1015.    MakeVarDefs (t->VAR_EXP.V);
  1016.   }
  1017.    return t;
  1018.  
  1019.   }
  1020.   }
  1021.   }
  1022.   if (t->VAR_EXP.V->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1023. # line 644 "SetDefs.puma"
  1024.  {
  1025.   tDefinitions Obj;
  1026.   {
  1027. # line 648 "SetDefs.puma"
  1028.  
  1029. # line 650 "SetDefs.puma"
  1030.    Obj = GetLocalDecl (t->VAR_EXP.V->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1031. # line 651 "SetDefs.puma"
  1032.    if (! (Obj != NoObject)) goto yyL9;
  1033.   {
  1034. # line 652 "SetDefs.puma"
  1035.    if (! (Obj -> Kind == kVarObject)) goto yyL9;
  1036.   {
  1037. # line 653 "SetDefs.puma"
  1038.    if (! (VarRank (Obj) > 0)) goto yyL9;
  1039.   {
  1040. # line 657 "SetDefs.puma"
  1041.    MakeIndexDefs (t->VAR_EXP.V->INDEXED_VAR.IND_EXPS);
  1042. # line 658 "SetDefs.puma"
  1043.    t->VAR_EXP.V->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object = Obj;
  1044.   }
  1045.   }
  1046.   }
  1047.   }
  1048.   {
  1049.    return t;
  1050.   }
  1051.  }
  1052. yyL9:;
  1053.  
  1054. # line 662 "SetDefs.puma"
  1055.  {
  1056.   tDefinitions Obj;
  1057.   tTree e;
  1058.   {
  1059. # line 666 "SetDefs.puma"
  1060.  
  1061. # line 668 "SetDefs.puma"
  1062.    Obj = GetGlobalDecl (t->VAR_EXP.V->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1063. # line 669 "SetDefs.puma"
  1064.    if (! (Obj != NoObject)) goto yyL10;
  1065.   {
  1066. # line 670 "SetDefs.puma"
  1067.    if (! (Obj -> Kind == kTypeObject)) goto yyL10;
  1068.   {
  1069. # line 674 "SetDefs.puma"
  1070.    MakeIndexDefs (t->VAR_EXP.V->INDEXED_VAR.IND_EXPS);
  1071. # line 676 "SetDefs.puma"
  1072.  
  1073. # line 678 "SetDefs.puma"
  1074.   e = mTYPE_OBJ (t->VAR_EXP.V->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1075.       e->TYPE_OBJ.Object = GetGlobalDecl (t->VAR_EXP.V->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1076.       e = mTYPE_EXP (e, t->VAR_EXP.V->INDEXED_VAR.IND_EXPS);
  1077.   }
  1078.   }
  1079.   }
  1080.   {
  1081.    return e;
  1082.   }
  1083.  }
  1084. yyL10:;
  1085.  
  1086. # line 685 "SetDefs.puma"
  1087.  {
  1088.   tTree f;
  1089.   {
  1090. # line 689 "SetDefs.puma"
  1091.  
  1092. # line 691 "SetDefs.puma"
  1093.    MakeIndexDefs (t->VAR_EXP.V->INDEXED_VAR.IND_EXPS);
  1094. # line 692 "SetDefs.puma"
  1095.    f = MakeFuncCall (t->VAR_EXP.V->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, t->VAR_EXP.V->INDEXED_VAR.IND_EXPS);
  1096. # line 693 "SetDefs.puma"
  1097.    MakeFuncCallDefs (f);
  1098.   }
  1099.   {
  1100.    return f;
  1101.   }
  1102.  }
  1103.  
  1104.   }
  1105.   }
  1106. # line 698 "SetDefs.puma"
  1107.   {
  1108. # line 702 "SetDefs.puma"
  1109.    MakeVarDefs (t->VAR_EXP.V);
  1110.   }
  1111.    return t;
  1112.  
  1113.   case kFUNC_CALL_EXP:
  1114. # line 706 "SetDefs.puma"
  1115.    return t;
  1116.  
  1117.   case kDO_EXP:
  1118. # line 710 "SetDefs.puma"
  1119.   {
  1120. # line 711 "SetDefs.puma"
  1121.    MakeVarDefs (t->DO_EXP.DO_ID);
  1122. # line 712 "SetDefs.puma"
  1123.  t->DO_EXP.RANGE = CheckExp (t->DO_EXP.RANGE);
  1124. # line 713 "SetDefs.puma"
  1125.    MakeIndexDefs (t->DO_EXP.BODY);
  1126.   }
  1127.    return t;
  1128.  
  1129.   }
  1130.  
  1131. # line 717 "SetDefs.puma"
  1132.   {
  1133. # line 718 "SetDefs.puma"
  1134.    printf ("CheckExp failed\n");
  1135. # line 719 "SetDefs.puma"
  1136.    FileUnparse (stdout, t);
  1137. # line 720 "SetDefs.puma"
  1138.    WriteTree (stdout, t);
  1139. # line 721 "SetDefs.puma"
  1140.    kill_in_protocol ();
  1141.   }
  1142.    return t;
  1143.  
  1144. }
  1145.  
  1146. static tTree ObjTypePtr
  1147. # if defined __STDC__ | defined __cplusplus
  1148. (register tDefinitions v)
  1149. # else
  1150. (v)
  1151.  register tDefinitions v;
  1152. # endif
  1153. {
  1154.   if (v->Kind == kVarObject) {
  1155.   if (v->VarObject.decl->Kind == kVAR_DECL) {
  1156. # line 740 "SetDefs.puma"
  1157.    return v->VarObject.decl->VAR_DECL.VAL;
  1158.  
  1159.   }
  1160.   if (v->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  1161. # line 744 "SetDefs.puma"
  1162.    return v->VarObject.decl->VAR_PARAM_DECL.VAL;
  1163.  
  1164.   }
  1165. # line 748 "SetDefs.puma"
  1166.   {
  1167. # line 749 "SetDefs.puma"
  1168.    printf ("Unknown VarObject for ObjTypePtr\n");
  1169. # line 750 "SetDefs.puma"
  1170.    FileUnparse (stdout, v->VarObject.decl);
  1171. # line 751 "SetDefs.puma"
  1172.    exit (- 1);
  1173.   }
  1174.    return NoTree;
  1175.  
  1176.   }
  1177. # line 755 "SetDefs.puma"
  1178.   {
  1179. # line 756 "SetDefs.puma"
  1180.    printf ("Unknown Object for ObjTypePtr\n");
  1181. # line 757 "SetDefs.puma"
  1182.    FileUnparse (stdout, v->Object.decl);
  1183. # line 758 "SetDefs.puma"
  1184.    exit (- 1);
  1185.   }
  1186.    return NoTree;
  1187.  
  1188. }
  1189.  
  1190. static tTree TreeTypePtr
  1191. # if defined __STDC__ | defined __cplusplus
  1192. (register tTree t)
  1193. # else
  1194. (t)
  1195.  register tTree t;
  1196. # endif
  1197. {
  1198. # line 772 "SetDefs.puma"
  1199.  tTree result;
  1200.   if (t->Kind == kVAR_OBJ) {
  1201. # line 774 "SetDefs.puma"
  1202.   {
  1203. # line 775 "SetDefs.puma"
  1204.  if (t->VAR_OBJ.Object != NoObject)
  1205.          result = ObjTypePtr (t->VAR_OBJ.Object);
  1206.         else
  1207.          result = NoTree;
  1208.   }
  1209.    return result;
  1210.  
  1211.   }
  1212.   if (t->Kind == kUSED_VAR) {
  1213. # line 782 "SetDefs.puma"
  1214.    return TreeTypePtr (t->USED_VAR.VARNAME);
  1215.  
  1216.   }
  1217.   if (t->Kind == kLOOP_VAR) {
  1218. # line 786 "SetDefs.puma"
  1219.    return TreeTypePtr (t->LOOP_VAR.LOOP_VARNAME);
  1220.  
  1221.   }
  1222.   if (t->Kind == kINDEXED_VAR) {
  1223. # line 790 "SetDefs.puma"
  1224.    return VarSelect (t, TreeTypePtr (t->INDEXED_VAR.IND_VAR));
  1225.  
  1226.   }
  1227.   if (t->Kind == kSELECTED_VAR) {
  1228. # line 794 "SetDefs.puma"
  1229.   {
  1230. # line 795 "SetDefs.puma"
  1231.  if (t->SELECTED_VAR.SELECTOR->REC_COMP.Object != NoObject)
  1232.          result = ObjTypePtr (t->SELECTED_VAR.SELECTOR->REC_COMP.Object);
  1233.         else
  1234.          result = NoTree;
  1235.   }
  1236.    return result;
  1237.  
  1238.   }
  1239.  yyAbort ("TreeTypePtr");
  1240. }
  1241.  
  1242. static tTree VarSelect
  1243. # if defined __STDC__ | defined __cplusplus
  1244. (register tTree var, register tTree stype)
  1245. # else
  1246. (var, stype)
  1247.  register tTree var;
  1248.  register tTree stype;
  1249. # endif
  1250. {
  1251.   if (var->Kind == kINDEXED_VAR) {
  1252.   if (stype->Kind == kARRAY_TYPE) {
  1253. # line 804 "SetDefs.puma"
  1254.    return stype->ARRAY_TYPE.ARRAY_COMP_TYPE;
  1255.  
  1256.   }
  1257. # line 808 "SetDefs.puma"
  1258.    return NoTree;
  1259.  
  1260.   }
  1261. # line 812 "SetDefs.puma"
  1262.   {
  1263. # line 813 "SetDefs.puma"
  1264.    printf ("Illegal VarSelect, var = ");
  1265. # line 814 "SetDefs.puma"
  1266.    FileUnparse (stdout, var);
  1267. # line 815 "SetDefs.puma"
  1268.    printf (" with type ");
  1269. # line 816 "SetDefs.puma"
  1270.    FileUnparse (stdout, stype);
  1271. # line 817 "SetDefs.puma"
  1272.    kill_in_protocol ();
  1273. # line 818 "SetDefs.puma"
  1274.    exit (- 1);
  1275.   }
  1276.    return stype;
  1277.  
  1278. }
  1279.  
  1280. static tTree MakeTypeExp
  1281. # if defined __STDC__ | defined __cplusplus
  1282. (register tIdent id, register tTree exps)
  1283. # else
  1284. (id, exps)
  1285.  register tIdent id;
  1286.  register tTree exps;
  1287. # endif
  1288. {
  1289. # line 830 "SetDefs.puma"
  1290.  
  1291. tTree v;
  1292.  
  1293. # line 834 "SetDefs.puma"
  1294.   {
  1295. # line 835 "SetDefs.puma"
  1296.  v = mTYPE_OBJ (id);
  1297.       v->TYPE_OBJ.Object = GetGlobalDecl (id);
  1298.       v = mTYPE_EXP (v, exps);
  1299.   }
  1300.    return v;
  1301.  
  1302. }
  1303.  
  1304. void BeginSetDefs ()
  1305. {
  1306. }
  1307.  
  1308. void CloseSetDefs ()
  1309. {
  1310. }
  1311.